(define (error m e)
  (begin
    (display m)
    (display e)
    (newline)))

(define (interpret t c)
  (if (builtin null? t)
      c
      (interpret (builtin cdr t) (interpret-step (builtin car t) c))))

(define builtins
  (builtin cons (builtin cons '+ +)
	(builtin cons (builtin cons '- -)
	      (builtin cons (builtin cons '* *)
		    (builtin cons (builtin cons '/ /)
			  (builtin cons (builtin cons 'mod modulo)
				'()))))))

(define assoc assq)

(define (interpret-arith t c)
  (if (builtin number? t)
      t
      (if (builtin symbol? t)
	  (let* ((v (assoc t (builtin car c))))
	    (if v
		(builtin cdr v)
		(error "Variable lookup error in arith: " t)))
	  (if (builtin pair? t)
	      (let* ((o (assoc (builtin car t) builtins)))
		(if o
		    (let* ((l (interpret-arith (builtin car (builtin cdr t)) c))
			  (r (interpret-arith (builtin car (builtin cdr (builtin cdr t))) c)))
		      ((builtin cdr o) l r))
		    (error "Not a builtin: " (builtin car t))))
	      (error "Invalid arithmetic expression: " t)))))

(define (interpret-bool t c)
  (if (pair? t)
      (if (builtin eq? (builtin car t) 'not)
	  (builtin not (interpret-bool (builtin car (builtin cdr t)) c))
	  (if (builtin eq? (builtin car t) '=)
	      (= (interpret-arith (builtin car (builtin cdr t)) c) (interpret-arith (builtin car (builtin cdr (builtin cdr t))) c))
	      (if (builtin eq? (builtin car t) '<)
		  (< (interpret-arith (builtin car (builtin cdr t)) c) (interpret-arith (builtin car (builtin cdr (builtin cdr t))) c))
		  (if (builtin eq? (builtin car t) 'and)
		      (interpret-bool (cadr t) (caddr t))
		      (if (builtin eq? (builtin car t) 'or)
			  (interpret-bool (cadr t) (caddr t))
			  (error "Invalid boolean expression: " t))))))
      (if (builtin eq? t 'true)
	  #t
	  (if (builtin eq? t 'false)
	      #f
	      (if (builtin symbol? t)
		  (let* ((v (assoc t (builtin car c))))
		    (if v
			(interpret-bool (builtin cdr v) c)
			(error "Variable lookup error in bool: " t)))
		  (error "Invalid boolean expression: " t))))))

; t = (assign a b) | (skip) | ...
; return = (assignments, output)
(define (interpret-step t c)
  (let* ((i (builtin car t)))
    (if (builtin eq? 'assign i)
	(let* ((id (builtin car (builtin cdr t)))
	      (val (interpret-arith (builtin car (builtin cdr (builtin cdr t))) c)))
	  (builtin cons (builtin cons (builtin cons id val) (builtin car c)) (builtin cdr c)))
	(if (builtin eq? 'skip i)
	    c
	    (if (builtin eq? 'out i)
		(let* ((val (builtin cdr (assoc (builtin car (builtin cdr t)) (builtin car c)))))
		  (builtin cons (builtin car c) (builtin cons val (builtin cdr c))))
		(if (builtin eq? 'if i)
		    (let* ((cn (interpret-bool (builtin car (builtin cdr t)) c))
			  (tr (builtin car (builtin cdr (builtin cdr t))))
			  (fa (builtin car (builtin cdr (builtin cdr (builtin cdr t))))))
		      (if cn
			  (interpret tr c)
			  (interpret fa c)))
		    (if (builtin eq? 'while i)
			(let* ((cn (builtin car (builtin cdr t)))
			      (bd (builtin car (builtin cdr (builtin cdr t)))))
			  (if (interpret-bool cn c)
			      (interpret-step t (interpret bd c))
			      c))
			(error "Error in step:" t))))))))

; supposedly prints out first 100 primes
(define primes '((assign p 0)
		 (assign n 2)
		 
		 (while (not (= p 100))
			((assign d 2)
			 (assign t 0)
			
			 (while (< d n)
				((if (= (mod n d) 0)
				     ((assign d n)
				      (assign t 1))
				     ((assign d (+ d 1))))))
				
			 (if (= t 0)
			     ((assign p (+ p 1))
			      (out n))
			     ((skip)))
			 
			 (assign n (+ n 1))))))
			   

;(display (interpret '((assign a 1) (skip) (assign b 2) (assign a 2) (out a)) '(() . ())))
;(newline)
;(display (interpret '((assign a 1) (skip) (assign b 2) (assign a (+ a b)) (out a)) '(() . ())))
;(newline)
;(display (interpret '((skip) (assign a 0) (assign b 1) (assign c 2) (if (= a 0) ((out b)) ((out c)))) '(() . ())))
;(newline)
;(display (interpret '((skip) (assign a 3) (assign b 1) (assign c 2) (if (= a 3) ((out b)) ((out c))) (out c))'(() . ())))
;(newline)
(define main
  (display (builtin cdr (interpret primes '(() . ())))))
